home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
mdidem
/
publish.frm
< prev
next >
Wrap
Text File
|
1995-05-02
|
7KB
|
303 lines
VERSION 2.00
Begin Form Publish
BackColor = &H00C0C0C0&
Caption = "Publishers"
ClientHeight = 1245
ClientLeft = 3690
ClientTop = 2460
ClientWidth = 3990
Height = 1935
Icon = PUBLISH.FRX:0000
Left = 3630
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 1245
ScaleWidth = 3990
Top = 1830
Width = 4110
Begin TextBox PubName
DataField = "Name"
DataSource = "Data1"
Height = 285
Left = 135
MaxLength = 40
TabIndex = 0
Top = 315
Width = 3615
End
Begin Data Data1
Caption = "Data1"
Connect = ""
DatabaseName = ""
Exclusive = 0 'False
Height = 285
Left = 2610
Options = 0
ReadOnly = 0 'False
RecordSource = "Publishers"
Top = 720
Width = 1140
End
Begin Label FormCommand
Caption = "FormCommand"
Height = 240
Left = 1440
TabIndex = 2
Top = 765
Visible = 0 'False
Width = 1185
End
Begin Label Label1
BackStyle = 0 'Transparent
Caption = "Name"
Height = 240
Index = 0
Left = 135
TabIndex = 1
Top = 135
Width = 1005
End
Begin Menu FileMenu
Caption = "&File"
Begin Menu OpenMenu
Caption = "&Open"
End
Begin Menu SaveMenu
Caption = "&Save"
End
Begin Menu NewMenu
Caption = "&New"
End
Begin Menu CloseMenu
Caption = "&Close"
End
Begin Menu sep
Caption = "-"
End
Begin Menu ExitMenu
Caption = "E&xit"
End
End
Begin Menu EditMenu
Caption = "&Edit"
Begin Menu RestoreMenu
Caption = "&Restore"
End
Begin Menu DeleteMenu
Caption = "&Delete"
End
End
Begin Menu WindowMenu
Caption = "&Window"
WindowList = -1 'True
Begin Menu WindowTileMenu
Caption = "&Tile"
End
Begin Menu WindowCascadeMenu
Caption = "&Cascade"
End
Begin Menu WindowArrangeIconsMenu
Caption = "&Arrange Icons"
End
End
End
Option Explicit
Option Compare Text
Const RecordType = "Publisher"
Sub DeleteMenu_Click ()
On Error GoTo DeleteError
If MsgBox("Are you sure that you want to delete this " & LCase$(RecordType) & "?", MB_YesNo + MB_DefButton2) = IDYes Then
Data1.Recordset.Delete
Data1.Refresh
End If
Exit Sub
DeleteError:
DataError Err, Error$
Exit Sub
End Sub
Sub ExitMenu_Click ()
Unload MainMdi
End Sub
Sub Form_Load ()
Height = 1935
Width = 4110
Data1.DatabaseName = gDatabaseName
Data1.Refresh
End Sub
Sub FormCommand_Change ()
Dim Cmd As String, Parameter As String
Dim i As Integer
If FormCommand = "" Then Exit Sub
Cmd = Trim$(FormCommand) & " "
i = InStr(Cmd, " ")
Parameter = Trim$(Mid$(Cmd, i + 1))
Cmd = Left$(Cmd, i - 1)
Select Case Cmd
Case "FindFirst"
Data1.Recordset.FindFirst Parameter
End Select
FormCommand = ""
End Sub
Sub NewMenu_Click ()
Data1.Recordset.AddNew
End Sub
Sub OpenMenu_Click ()
OpenDialog.Show 1
End Sub
Sub RestoreMenu_Click ()
Data1.UpdateControls
End Sub
Sub SaveMenu_Click ()
On Error GoTo SaveMenuError
If CheckData() Then
Data1.UpdateRecord
Data1.Recordset.Bookmark = Data1.Recordset.LastModified
End If
Exit Sub
SaveMenuError:
Select Case Err
Case Else
DataError Err, Error$
End Select
Exit Sub
End Sub
Sub WindowArrangeIconsMenu_Click ()
MainMdi.Arrange Arrange_Icons
End Sub
Sub WindowCascadeMenu_Click ()
MainMdi.Arrange Cascade
End Sub
Sub WindowTileMenu_Click ()
MainMdi.Arrange Tile_Horizontal
End Sub
Function CheckData () As Integer
If PubName = "" Then
MsgBox "Unable to save record. Publisher name is blank."
CheckData = False
Else
CheckData = True
End If
End Function
Sub CloseMenu_Click ()
Unload Me
End Sub
Sub Data1_Reposition ()
If Data1.EditMode = Data_EditAdd Then
Caption = "Adding New Publisher"
ElseIf Data1.Recordset.BOF Or Data1.Recordset.EOF Then
Caption = "No Publisher Records Found"
Else
Caption = "Publisher #" & Data1.Recordset("PubID")
End If
End Sub
Sub Data1_Validate (Action As Integer, Save As Integer)
Select Case Action
Case Data_ActionDelete
' this is due to a delete command
' calling routine should confirm deletion
Case Data_ActionUpdate
' make sure data is valid
If CheckData() Then
Save = True
Else
Action = Data_ActionCancel
Save = False
End If
Case Else
If Save Then
' this is due to an implicit save command
' make sure they actually want to save it
If MainMdi.WindowState = Minimized Then MainMdi.WindowState = Normal
If Me.WindowState = Minimized Then Me.WindowState = Normal
Me.Show
Select Case MsgBox("Do you want to save the changes to this " & RecordType & "?", MB_YesNoCancel)
Case IDYes
' they want to save it
' make sure data is valid
If Not CheckData() Then
Action = Data_ActionCancel
Save = False
End If
Case IDNo
Save = False
Case Else
Save = False
Action = Data_ActionCancel
End Select
End If
End Select
If Save Then
On Error GoTo ValidateError
' perform the save manually
Save = False
Data1.UpdateRecord
Data1.Recordset.Bookmark = Data1.Recordset.LastModified
SendAll "Refresh Publisher"
End If
Exit Sub
ValidateError:
DataError Err, Error$
Action = Data_ActionCancel
Exit Sub
End Sub